perm filename RESTX.F4[RST,LCS] blob sn#180069 filedate 1975-10-08 generic text, type T, neo UTF8
00100		SUBROUTINE RESTS(PN,Q)
00500		COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
00600		COMMON /LLL/L,LL,I,IX
00650		DIMENSION PN(1),Q(1)
00700		EQUIVALENCE (RQ(10),XLFT),(K,RQ(3)),(RR,RQ(4)),(LB,RQ(5))
00900		XLFT=0
00910		SIG=-99
00955		CLEF=-99
01000		REST=0
01100		K=1
01200	50	JL=PN(K)
01300		R=Q(JL+1)
01400		IF(XLFT.NE.0)GO TO 2
01500		IF(R.LE.4)XLFT=Q(JL+3)
01546	
01550	2	IF(R.NE.3)GO TO 5
01554		RR=Q(JL+5)
01558		IF(Q(JL).LT.3)RR=0
01562		IF(RR.NE.CLEF)GO TO 3
01574	
01578	60	Q(JL+1)=-1
01582		GO TO 231
01586	5	IF(R.NE.17)GO TO 3
01590		IF(Q(JL+5).EQ.SIG)GO TO 60
01594		SIG=Q(JL+5)
01600	3	IF(R.NE.2)GO TO 231
01700		IF(Q(JL).GE.6)GO TO 7
01710		IF(Q(IFIX(PN(K-1))+1).NE.4)GO TO 231
01730	C ANY REST BETWEEN 2 BARS IS A "WHOLE" REST.
01740	C WON'T CATCH IT IF TERE IS A CLEF, METER, ETC. PRESENT
01750		IF(Q(IFIX(PN(K+1))+1).NE.4)GO TO 231
01800	C FOUND A WHOLE REST MEAS.
01900	7	IF(REST.NE.0)GO TO 6
02000		JR=JL+8
02100	C  POINTER TO REST NUM.
02110		R=Q(JR-1)
02120		IF(R.LT.5)R=5
02200		Q(JR-1)=R*.6
02300	C  REDUCE SIZE OF REST'S TIME SO IT WILL TAKE LESS SPACE.
02400	6	REST=REST+1
02500		Q(JR)=REST
02600		JL=K+2
02700		IF(JL.GE.L)RETURN
02710	CC	LC=PN(K+1)
02755	CC	IF(Q(LC+1))JL=JL+1
02760	C WAS THERE AN EXTRA BAR?
02800		LB=PN(JL)
02900		IF(Q(LB+1).NE.2)GO TO 233
03000	C NEXT IS TO COMBINE MEASURES OF REST
03100		IF(Q(LB).LT.6)GO TO 233
03200	C  SKIP NON-WHOLE RESTS
03300		N=PN(JL-1)
03400		IF(Q(N+1).NE.4)GO TO 233
03500	C  IS REST FOLLOWED BY A BAR?
03700	C SO IT WON'T BE FOUND NEXT TIME AROUND.
03800		Q(LB+1)=-1
03900	C  CHANGE CODE #
04000		Q(N+1)=-1 
04100		K=JL
04200		GO TO 6
04300	
04400	233	REST=0
04500	231	K=K+1
04600		IF(K.LT.L)GO TO 50
04700		END
04800	
04900	
05000	CC	SUBROUTINE ADDRST(RPOS,XWDS,PN)
05100	CC	COMMON /XXX/LK,LP,JY /LLL/L,LL,I,IX
05400	CC	COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
05600	CC	DIMENSION XWDS(1),PN(1)
05900	CC	PN(LK)=6
06000	CC	PN(LK+1)=2
06100	CC	PN(LK+2)=RS
06200	CC	PN(LK+3)=RPOS-1.
06300	CC	PN(LK+4)=0   
06400	CC	PN(LK+5)=0   
06500	CC	PN(LK+6)=0   
06600	CC	PN(LK+7)=6.  
06700	CC	PN(LK+8)=-1
06800	CC	LK=LK+9
06900	CC	L=L+1
07000	CC	XWDS(L)=LK
07100	C NEXT ADDS A BAR LINE
07300	CC	PN(LK)=2
07400	CC	PN(LK+1)=4
07500	CC	PN(LK+2)=RS
07600	CC	PN(LK+3)=RPOS
07700	CC	PN(LK+4)=1.
07800	CC	LK=LK+5
07900	CC	L=L+1
08000	CC	XWDS(L)=LK
08200	CC	END